home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / winword / collec.zip / FCOLLECT.TXT next >
Text File  |  1993-06-28  |  15KB  |  456 lines
  1. '****************************************
  2. 'Collector - collects footnotes from the files in a Help project.
  3. '****************************************
  4. Declare Sub Yield Lib "Kernel"        'For yield command
  5. Sub Main
  6. Dim ErrorLev, ffPath$, ffName$, UseRTF
  7. ErrorLev = 0
  8. GetProjDir ffPath$, ffName$, ErrorLev    'What you'd think
  9. If ErrorLev <> 0 Then Goto Quit
  10. GetRunMode RunMode, ErrorLev        'Run quick, or allow access to other programs
  11. If ErrorLev <> 0 Then Goto Quit
  12. DOCorRTF UseRTF, ErrorLev        'Use .DOC files or .RTF files
  13. If ErrorLev <> 0 Then Goto Quit
  14.  
  15. JustDir ffPath$                'Separate the path from the file name...
  16. ChDir ffPath$                '...and change to that directory
  17. JustName ffName$            'Separate the file name from the path
  18. ToolsOptionsView .Hidden = 0
  19. CollectFootnotes ffName$, RunMode, UseRTF    'Main routine
  20. If  AppMinimize() Then AppRestore
  21. MsgBox "All the footnotes have been collected.", "Footnote Collector Macro", 64    'We're done!
  22. Quit:
  23. If  AppMinimize() Then AppRestore
  24. End Sub
  25.  
  26. '****************************************
  27. Sub GetProjDir(ffPath$, ffName$, ErrorLev)
  28. Dim NumFndFiles, i, n
  29.     FileFind .Location = "All local drives", .Name = "*.hpj", .Options = 0, .SortBy = 4
  30.     NumFndFiles = CountFoundFiles()
  31.     Dim HPJ$(NumFndFiles)
  32.     For i = 1 To NumFndFiles
  33.         HPJ$(i - 1) = FoundFileName$(i)
  34.     Next
  35.  
  36.     Begin Dialog UserDialog 558, 142, "Select a project file"
  37.         ListBox 14, 43, 414, 84, HPJ$(), .ListBox1
  38.         OKButton 448, 43, 88, 21
  39.         CancelButton 448, 67, 88, 21
  40.         Text 14, 9, 475, 13, "Select the Windows Help project from which to collect"
  41.         Text 14, 22, 187, 13, "the footnote information."
  42.     End Dialog
  43.     Dim HPJ As UserDialog
  44.     n = Dialog(HPJ)        'Figure out how to do On Error here
  45.     If n = 0 Then ErrorLev = 1
  46.     ffName$ = HPJ$(HPJ.ListBox1)
  47.     ffPath$ = ffName$
  48. End Sub
  49.  
  50. '****************************************
  51. Sub GetRunMode(Fast, ErrorLev)
  52. Dim n
  53.     Begin Dialog UserDialog 484, 156, "Select Run Mode"
  54.         OKButton 379, 6, 88, 21
  55.         CancelButton 379, 30, 88, 21
  56.         OptionGroup  .Opt1
  57.             OptionButton 10, 6, 320, 16, "FAST MODE - Runs quick as possible,"
  58.             OptionButton 10, 55, 344, 16, "RELAXED MODE - Slower, but allows you"
  59.         Text 33, 21, 256, 13, "but tends to be a hog with system"
  60.         Text 33, 34, 80, 13, "resources."
  61.         Text 33, 70, 311, 13, "access to other programs, such as email,"
  62.         Text 33, 83, 215, 13, "games to pass the time, etc."
  63.         Text 33, 108, 380, 13, "Both modes will reduce the application to an icon."
  64.         Text 33, 121, 343, 13, "Without having to update the screen, macros"
  65.         Text 33, 134, 191, 13, "typically run much faster."
  66.     End Dialog
  67.     Dim dlg As UserDialog
  68.     n = Dialog(dlg)
  69.     If n = 0 Then ErrorLev = 1    'If they click Cancel, let the main routine know
  70.     If dlg.Opt1 = 0 Then
  71.         Fast = 1    'run without pauses
  72.     Else
  73.         Fast = 0    'run in minimized mode
  74.     EndIf
  75. End Sub
  76.  
  77. '****************************************
  78. Sub DOCorRTF(UseRTF, ErrorLev)
  79. Dim n
  80.     Begin Dialog UserDialog 460, 96, "Use which file type?"
  81.         Text 10, 6, 325, 13, "If available, this macro will run much faster"
  82.         Text 10, 19, 312, 13, "on .DOC files than on .RTF files.  Do you"
  83.         Text 10, 33, 209, 13, "want to use the .DOC files?"
  84.         OptionGroup  .Opt1
  85.             OptionButton 42, 50, 137, 16, "Use .RTF files"
  86.             OptionButton 42, 66, 140, 16, "Use .DOC files"
  87.         OKButton 362, 11, 88, 21
  88.         CancelButton 362, 35, 88, 21
  89.     End Dialog
  90.     Dim dlg As UserDialog
  91.     n = Dialog(dlg)
  92.     If n = 0 Then ErrorLev = 1    'If they click Cancel, let the main routine know
  93.     If dlg.Opt1 = 0 Then UseRTF = 1    'They chose to use .RTF files (default)
  94. End Sub
  95.  
  96.  
  97. '****************************************
  98. Sub JustDir(t$)        'Separate the path from the file name
  99. Dim i
  100.     i = Len(t$)
  101.     While Mid$(t$, i, 1) <> "\"
  102.         i = i - 1
  103.     Wend
  104.     i = i - 1
  105.     t$ = Left$(t$, i)
  106. End Sub
  107.  
  108. '****************************************
  109. Sub JustName(t$)        'Separate the file name from the path
  110. Dim i
  111.     i = Len(t$)
  112.     While Mid$(t$, i, 1) <> "\"
  113.         i = i - 1
  114.     Wend
  115.     i = Len(t$) - i
  116.     t$ = Right$(t$, i)
  117. End Sub
  118.  
  119. '****************************************
  120. Sub FindFilesSection(ffName$)
  121. 'Locates the [Files] section of a .HPJ file
  122. Dim done, r$
  123. Open ffName$ For Input As #1    'Open the .HPJ file
  124. done = 0
  125. On Error Goto Oops
  126. While done = 0
  127.     Read #1, r$        'Get a line from the file
  128.     r$ = Left$(r$, 7)
  129.     If(r$ = "[FILES]" Or r$ = "[files]" Or r$ = "[Files]") Then
  130.         done = 1
  131.     EndIf
  132. Oops:
  133. Wend
  134. End Sub
  135.  
  136. '****************************************
  137. Sub CleanupName(rtf$)    'Gets rid of any comments after the filename
  138. Dim n1, n2
  139.     n1 = InStr(rtf$, ".RTF")
  140.     n2 = InStr(rtf$, ".rtf")
  141.     If n1 <> 0 Then rtf$ = Left$(rtf$, n1 + 3)
  142.     If n2 <> 0 Then rtf$ = Left$(rtf$, n2 + 3)
  143. End Sub
  144.  
  145. '****************************************
  146. Sub CollectFootnotes(ffName$, RunMode, UseRTF)
  147. 'This is just Collector as a subroutine, with the RunMode option added.
  148. 'We've already changed directories, and have the filename, so first we need to
  149. 'find out how many files there are.  Then dim an array and fill it up.  Then
  150. 'Collector can handle the rest, as is.
  151.  
  152. Dim HelpTitle$, KeyTitle$, Browse$, KeyWord$, HelpID$, Comments$
  153. Dim BuildTag$, EntryMacro$, r$, RTFCount, ffAppend, done, n1, n2, i
  154.  
  155. 'Find out if we should append to TRACKER.CSV or create a new one
  156. r$ = Files$("tracker.csv")
  157. If r$ <> "" Then AppendCSV ffAppend
  158.  
  159. 'This section counts the files
  160. FindFilesSection ffName$        'Open the .HPJ file and locate the [Files] section
  161. done = 0
  162. RTFCount = 0
  163. While done = 0
  164.     Input #1, r$
  165.     If Eof(1) Then done = 1
  166.     If Left$(r$, 1) <> ";" Then
  167.         n1 = InStr(r$, ".RTF")
  168.         n2 = InStr(r$, ".rtf")
  169.         If(n1 > 0 Or n2 > 0) Then
  170.             RTFCount = RTFCount + 1
  171.         Else
  172.             done = 1
  173.         EndIf
  174.     EndIf
  175. Wend
  176. Close #1        'Close the .HPJ file so we can open it again
  177.  
  178. 'Now we open the .HPJ file and read the file names into an array
  179. FindFilesSection    ffName$    'Reopen the file and find the [FILES] section again
  180. Dim RTF$(RTFCount)
  181. For i = 1 To RTFCount
  182.     Input #1, r$
  183.     If Left$(r$, 1) <> ";" Then
  184.         CleanupName r$
  185.         RTF$(i) = r$
  186.     Else
  187.         i = i - 1
  188.     EndIf
  189. Next                'Now we have the array of names and can read them.
  190. Close #1
  191.  
  192. If UseRTF = 0 Then        'If user wants to read .DOC files
  193.     For i = 1 To RTFCount
  194.         RTF$(i) = Left$(RTF$(i), Len(RTF$(i)) - 3)
  195.         RTF$(i) = RTF$(i) + "doc"
  196.     Next
  197. EndIf
  198.  
  199. 'Open a text file for writing, and overwrite if already existing, then write the column titles to it.
  200.  
  201. If ffAppend = 1 Then
  202.     Open "TRACKER.CSV" For Append As #1
  203. Else
  204.     Open "TRACKER.CSV" For Output As #1
  205. EndIf
  206.  
  207. If ffAppend = 0 Then
  208.     Write #1, "File Name", \
  209.         "Topic Title", \
  210.         "Keyword Search Title", \
  211.         "Context ID (Help Token)", \
  212.         "Browse Seq.", \
  213.         "Key Words", \
  214.         "Comments", \
  215.         "Build Tags", \
  216.         "Entry Macro"
  217. EndIf
  218.  
  219. REM    WOPR.Echo 0        'Turn off screen updates
  220.  
  221. AppMinimize            'Turn off screen updates by minimizing
  222. 'Start opening TOC files and run the main routines.
  223. For i = 1 To RTFCount
  224.     DisableAutoMacros 1        'Don't let Auto... macros mess us up
  225.     FileOpen .Name = RTF$(i), .ReadOnly = 0
  226.     If Not DocMaximize() Then DocMaximize
  227.  
  228.     'Process the help topics and get the footnotes
  229.     GetFootNotes RTF$(i), KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, \
  230.     BuildTag$, EntryMacro$
  231.  
  232.  
  233.     SetDirty 0        'Mark file as unchanged
  234.     FileClose             'Close file without saving it.
  235. Next                'Next file
  236.  
  237. 'Whatever the outcome, close up shop and put things back the way they were.
  238. TheEnd:                'On Error, close the file and end the macro.
  239. Close #1                'Close TRACKER.CSV
  240. DisableAutoMacros 0        'Reenable AutoMacros
  241. REM    WOPR.Echo 1        'Echo back on
  242. End Sub    
  243.  
  244. '*************************************************
  245. 'Processes all help topics in the document
  246. Sub GetFootNotes(FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, \
  247.     BuildTag$, EntryMacro$)
  248.  
  249. Print "Working on " + FileNm$    'Let user know what's up....
  250.  
  251. 'Do the very first topic in the file, which is assumed to be the first thing in the file.
  252. StartOfDocument
  253. 'Initialize variables for each heading
  254.     HelpTitle$ = "-"
  255.     KeyTitle$ = "-"
  256.     Browse$   = "-"
  257.     KeyWord$  = "-"
  258.     HelpID$   = "-"
  259.     Comments$  = "-"
  260.     BuildTag$ = "-"
  261.     EntryMacro$ = "-"
  262. GetFeet FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$
  263.  
  264. 'Get text of current topic title
  265. ParaDown 1, 1 : CharLeft 1, 1 : HelpTitle$ = Selection$()
  266.  
  267. 'Write out the global footnote info
  268. Write #1, FileNm$, HelpTitle$, KeyTitle$, HelpID$, \
  269. Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$
  270.  
  271. 'Search for page breaks, which indicate a new topic
  272. '*********
  273. EditFindClearFormatting
  274. EditFind .Find = "^d", .Direction = 2, .Format = 0
  275. While EditFindFound()
  276.     If RunMode = 0 Then Yield    'Let the system have some time
  277.     HelpTitle$ = "-"        'Initialize variables for each heading
  278.     HelpID$   = "-"
  279.     KeyTitle$ = "-"
  280.     Browse$   = "-"
  281.     KeyWord$  = "-"
  282.     Comments$  = "-"
  283.     CharRight 1        'First character after page break
  284.  
  285.     'Do the footnotes
  286.     GetFeet FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, \
  287.         EntryMacro$
  288.  
  289.     'Get text of current topic title
  290.     ParaDown 1, 1
  291.     CharLeft 1, 1 : HelpTitle$ = Selection$()
  292.     If Mid$(HelpTitle$, 1, 1) = Chr$(13) Then HelpTitle$ = "--"
  293.     If Len(HelpTitle$) > 90 Then HelpTitle$ = Left$(HelpTitle$, 40)
  294.  
  295. 'ShowVars
  296.     'Write out the global footnote info
  297.     Write #1, FileNm$, HelpTitle$, KeyTitle$, HelpID$, \
  298.     Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$
  299.  
  300.     EditFind .Find = "^d", .Direction = 2, .Format = 0    'Search again
  301. Wend
  302. End Sub
  303.  
  304. '****************************
  305. 'Extract footnote strings.  Each loop extracts one footnote string.
  306. 'Loop until text is encountered that is not a footnote, or until a
  307. 'footnote we don't recognize is encountered.
  308. Sub GetFeet(FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$)
  309. Dim chFootnote$
  310. FootnoteLoop:
  311.     'Assert: footnotes not visible, focus in main pane
  312.     'Skip whitespace between footnotes
  313.     While Selection$() = " "
  314.         CharRight
  315.     Wend
  316.  
  317.     ' Check for non-footnote character
  318.     CharRight 1, 1
  319.     chFootnote$ = Selection$()
  320.  
  321.     'NOTE: Technically, footnotes don't have to be superscript, and the compiler
  322.     'would accept them if they weren't.  However, this test makes the following loop
  323.     'safer, and Winword will never create footnotes that aren't superscripted.
  324.  
  325. REM    If SuperScript() <> 1 Then Goto endfootnoteloop    'This is one way to check for footnotes
  326.     'Move to the footnote text for this footnote, and verify that the footnote character
  327.     'here matches the one  in the main text.
  328.     ViewFootnotes 1
  329.     If Selection$() <> chFootnote$ Then    'This is the other way to check for footnotes
  330.         ViewFootnotes 0
  331.         Goto endfootnoteloop
  332.     End If
  333.     'Extract the footnote text
  334.     CharRight
  335.     While Selection$() = " "
  336.         CharRight
  337.     Wend
  338.     'Select all the text for this footnote.  Since none of the footnotes
  339.     'can legally contain a paragraph marker, and every footnote ends
  340.     'in one, search for that.
  341.     ExtendSelection    'extend selection mode
  342.     EditFind .Find = "^p", .Direction = 2, .Format = 0
  343.     CharLeft 1, 1
  344.     Cancel
  345.     szFootnote$ = Selection$()
  346.     ViewFootnotes 0
  347. REM
  348.     FormatCharacter .Position = "3 pt", .Spacing = "0 pt"
  349. REM
  350.  
  351.     'Assign footnote text to appropriate field in Topic dialog
  352.     Select Case Asc(chFootnote$)
  353.     Case Asc("$")
  354.         KeyTitle$ = szFootnote$
  355.  
  356.     Case Asc("#")
  357.         HelpID$ = szFootnote$
  358.  
  359.     Case Asc("K"), Asc("k")
  360.         Keyword$ = szFootnote$
  361.     Case Asc("+")
  362.         Browse$ = szFootnote$
  363.     Case Asc("*")
  364.         BuildTag$ = szFootnote$
  365.     Case Asc("!")                    
  366.         EntryMacro$ = szFootnote$    
  367.     Case Asc("@")
  368.         Comments$ = szFootnote$
  369.     Case Else
  370.         fBreakOut = - 1        'illegal to jump out of a Select
  371.     End Select
  372.     If fBreakOut Then Goto endfootnoteloop
  373.  
  374.     'Deselect footnote character, and repeat loop
  375.     CharRight
  376.     Goto footnoteloop
  377.  
  378. endfootnoteloop:
  379.     'Assert: footnotes not visible
  380.     CharLeft    ' Deselect non-footnote character
  381. End Sub
  382.  
  383. '****************************
  384. 'Find out whether to append or overwrite an existing tracker file
  385. Sub AppendCSV(ffAppend)
  386. Dim n, Loop
  387. DialogLoop:
  388. Begin Dialog UserDialog 340, 92, "Append or Overwrite?"
  389.     Text 26, 6, 292, 13, "The file TRACKER.CSV already exists."
  390.     Text 26, 20, 273, 13, "Do you want to overwrite the file or "
  391.     Text 26, 34, 180, 13, "add on to the end of it?"
  392.     PushButton 10, 60, 88, 21, "&Overwrite"
  393.     PushButton 114, 60, 88, 21, "&Append"
  394.     PushButton 218, 60, 88, 21, "&Help"
  395. End Dialog
  396. Redim dlg As UserDialog
  397. Loop = 0 : n = Dialog(dlg)
  398. Select Case n
  399.     Case 1    'Overwrite - the default
  400.         ffAppend = 0    'don't append
  401.     Case 2    'Append
  402.         ffAppend = 1    'we should append to the file
  403.     Case 3    'Help - provide an explanation
  404.         Redim inst$(38)
  405.         inst$(0) = "If Collector runs without problem on your files,"
  406.         inst$(1) = "you can ignore these instructions."
  407.         inst$(2) = ""
  408.         inst$(3) = "Because of a memory problem in WinWord, it can"
  409.         inst$(4) = "occasionally run out of memory when you least"
  410.         inst$(5) = "expect it.  If you have a Help project of more"
  411.         inst$(6) = "than 16 to 18 files, or if your Help system uses a"
  412.         inst$(7) = "lot of links, then it's likely you'll run out of"
  413.         inst$(8) = "memory before the macro finishes."
  414.         inst$(9)  = ""
  415.         inst$(10) = "Fortunately, I've figured out a workaround:"
  416.         inst$(11) = "1) Run the macro until it runs out of memory."
  417.         inst$(12) = "2) Exit Windows entirely.  (If you're superstitious"
  418.         inst$(13) = "    you might want to reboot at this time.)"
  419.         inst$(14) = "3) Use a text editor or word processor (you"    
  420.         inst$(15) = "    could even use Word) to remove all the lines"
  421.         inst$(16) = "    from TRACKER.CSV in which the first entry is"
  422.         inst$(17) = "    the name of the file the macro was working on"
  423.         inst$(18) = "    when it crapped out.  For example, if the"
  424.         inst$(19) = "    macro quit while working on CHAP14.DOC,"
  425.         inst$(20) = "    open the file in your text editor and find the"
  426.         inst$(21) = "    first line which begins with " + Chr$(34) + "CHAP14.DOC" + \
  427.                 Chr$(34) + "."
  428.         inst$(22) = "    Delete everything after that."
  429.         inst$(23) = "4) Save TRACKER.CSV (as Text Only if you use"
  430.         inst$(24) = "    Word or another word processor)."
  431.         inst$(25) = "5) Copy your project file to another name.  For"
  432.         inst$(26) = "    example, copy MYPROJ.HPJ to TEMP.HPJ."
  433.         inst$(27) = "6) Edit the copy of your project file and remove"
  434.         inst$(28) = "    all the names in the [Files] section BEFORE"
  435.         inst$(29) = "    the file the macro crapped out on.  In my"
  436.         inst$(30) = "    example, I'd remove the names CHAP1.DOC"
  437.         inst$(31) = "    through CHAP13.DOC, leaving CHAP14.DOC"
  438.         inst$(32) = "    through, say, CHAP20.DOC."
  439.         inst$(33) = "7) Save the copy of the project file."
  440.         inst$(34) = "8) Restart WinWord and restart the macro.  This"
  441.         inst$(35) = "    time, choose the copy of the project file."
  442.         inst$(36) = "9) When prompted, choose Append instead of"
  443.         inst$(37) = "    Overwrite."
  444.  
  445.         Begin Dialog UserDialog 536, 284, "Overwrite vs. Append"
  446.             ListBox 15, 10, 405, 273, Inst$(), .ListBox1
  447.             PushButton 432, 109, 88, 21, "Done"
  448.         End Dialog
  449.         Redim InstText As UserDialog
  450.         n = Dialog(InstText)
  451.         Loop = 1
  452. End Select
  453. If Loop = 1 Then Goto DialogLoop
  454. End Sub
  455.  
  456.